home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 4 / Mac Giga-ROM 4.0 - 1993.toast / FILES / BBS / SECOND_SIGHT / CreateSectiondir / CreateSectionDir.p < prev    next >
Encoding:
Text File  |  1990-09-21  |  6.3 KB  |  320 lines  |  [TEXT/PJMM]
  1. PROGRAM CreateSectionDir;
  2.  
  3.     USES
  4.         HFS, StackStuff;
  5.  
  6.  
  7.     CONST
  8.  
  9.         line1 = 'Library Report - ';
  10.         line2 = 'Last Updated - ';
  11.  
  12.         title1 = 'ID#   Program Name          Acc.  T  Uploaded By          Date        Blocks';
  13.         title2 = '---- ---------------------  ----  -  -------------------  ----------  ------';
  14.  
  15.  
  16.  
  17.  
  18.     VAR
  19.         currentID : integer;
  20.         outFile : text;
  21.  
  22.         dateStr, acctStr, typeStr, uploadedByStr : str255;
  23.  
  24. {================================================================================}
  25.  
  26. {==================================================================================}
  27.  
  28.     PROCEDURE DisplayOSErr (theOSErr : integer;
  29.                                     theStr : str255);
  30.     BEGIN
  31.         IF theOSErr <> noErr THEN
  32.             writeln('OSErr: ', theOSErr, ' "', theStr, '"');
  33.     END;
  34.  
  35.     PROCEDURE FailOSErr (theOSErr : integer);
  36.     BEGIN
  37.         IF theOSErr <> noErr THEN
  38.             writeln('An error, #', theOSErr, ' occurred.');
  39.     END;
  40.  
  41.  
  42.  
  43.     FUNCTION GetKthIndexedFileInDirectory (k : integer;
  44.                                     vRefNum : integer;
  45.                                     dirID : integer;
  46.                                     VAR paramBlock : CInfoPBRec) : boolean;
  47.  
  48.         VAR
  49.             theOSErr : integer;
  50.  
  51.     BEGIN
  52.  
  53.         paramBlock.ioVRefNum := vRefNum;
  54.         paramBlock.ioDirID := dirID;
  55.         paramBlock.ioFDirIndex := k;
  56.  
  57.         theOSErr := PBGetCatInfo(@paramBlock, FALSE);
  58.  
  59.         IF theOSErr = -43 THEN
  60.             GetKthIndexedFileInDirectory := false
  61.         ELSE IF theOSErr <> noErr THEN
  62.             BEGIN
  63.                 writeln('GetKthIndexedFileInDirectory:  osErr = ', theOSErr);
  64.                 GetKthIndexedFileInDirectory := false
  65.             END
  66.         ELSE
  67.             GetKthIndexedFileInDirectory := true;
  68.  
  69.     END;
  70.  
  71.  
  72.  
  73.     PROCEDURE DisplayParamBlockInfo (paramBlock : CInfoPBRec);
  74.         VAR
  75.             fileName : str255;
  76.             size : longint;
  77.     BEGIN
  78.  
  79.         writeln('Writing file #', currentID, '  ', paramBlock.ioNamePtr^);
  80.  
  81.  
  82.         write(outFile, currentID : 4);
  83.         write(outFile, '  ');
  84.  
  85.         fileName := concat(paramBlock.ioNamePtr^, '                    ');
  86.         write(outFile, fileName : 20);
  87.         write(outFile, '  ');
  88.  
  89.         write(outFile, acctStr);
  90.         write(outFile, '  ');
  91.  
  92.         write(outFile, typeStr);
  93.         write(outFile, '  ');
  94.  
  95.         write(outFile, uploadedByStr);
  96.         write(outFile, '  ');
  97.  
  98.         write(outFile, dateStr);
  99.         write(outFile, '  ');
  100.  
  101.         size := (paramBlock.ioFlPyLen + paramBlock.ioFlRPyLen) DIV 128 + 1;
  102.         write(outFile, size : 6);
  103.  
  104.         writeln(outFile);
  105.  
  106.  
  107.         writeln(outFile, '       DESC:<Description>');
  108.  
  109.         writeln(outFile, '       KEY:<Key>');
  110.  
  111.     END;
  112.  
  113.  
  114.  
  115.     PROCEDURE WriteSubdirectoryToSectionDirFile (volToCatalog : integer;
  116.                                     DoCatalog : boolean);
  117.  
  118.         VAR
  119.             paramBlock : CInfoPBRec;
  120.             theOSErr : integer;
  121.  
  122.             vRefNum : integer;
  123.             dirID : integer;
  124.             fileIndex : integer;
  125.  
  126.             volName : str255;
  127.             theNameStr : str255;
  128.  
  129.             subdirectories : StackType;
  130.     BEGIN
  131.  
  132.         FailOSErr(SetVol(NIL, volToCatalog));
  133.         FailOSErr(GetVol(@theNameStr, vRefNum));
  134.         FailOSErr(SetVol(@theNameStr, 0));
  135.         FailOSErr(GetVol(NIL, vRefNum));
  136.  
  137.         writeln('Vol to catalog - vRef:', vRefNum, '  dirID:', volToCatalog);
  138.  
  139.         dirID := 0;
  140.  
  141.         StackInitialize(subdirectories);
  142.         StackPush(subDirectories, dirID);
  143.         theNameStr := 'Keith';
  144.  
  145.         paramBlock.ioNamePtr := @theNameStr;
  146.  
  147.         WHILE StackEmpty(subDirectories) = FALSE DO
  148.             BEGIN
  149.                 dirID := StackPop(subDirectories);
  150.                 fileIndex := 1;
  151.  
  152.                 writeln('Directory ID ', dirID, '   stack size ', subDirectories.size);
  153.  
  154.                 WHILE GetKthIndexedFileInDirectory(fileIndex, vRefNum, dirID, paramBlock) DO
  155.                     BEGIN
  156.  
  157.                         IF BitTst(@paramBlock.ioFlAttrib, 3) = TRUE THEN
  158.                             BEGIN
  159.                                 StackPush(subDirectories, paramBlock.ioDirID);
  160.                                 writeln('PUSHING ', paramBlock.ioDirID, '  name ', paramBlock.ioNamePtr^);
  161.                             END
  162.                         ELSE IF DoCatalog THEN
  163.                             BEGIN
  164.                                 currentID := currentID - 1;
  165.                                 DisplayParamBlockInfo(paramBlock);
  166.                             END
  167.                         ELSE
  168.                             BEGIN
  169.                                 currentID := currentID + 1;
  170.                                 writeln('COUNTING #', currentID, ' "', paramBlock.ioNamePtr^, '"');
  171.                             END;
  172.                         fileIndex := fileIndex + 1;
  173.  
  174.                     END;
  175.  
  176.             END; {of while StackEmpty() = FALSE }
  177.  
  178.     END;
  179.  
  180. {=================================================================}
  181.  
  182.     PROCEDURE OpenOutputFile (fileName : str255;
  183.                                     vRefNum : integer);
  184.         CONST
  185.             LibraryReportID = 128;
  186.             lastUploadedID = 129;
  187.             acctStrID = 130;
  188.             typeStrID = 131;
  189.             uploadedByID = 132;
  190.             dateStrID = 133;
  191.  
  192.         VAR
  193.             currentVRefNum : integer;
  194.  
  195.             strH : StringHandle;
  196.  
  197.     BEGIN
  198.  
  199.         FailOSErr(GetVol(NIL, currentVRefNum));
  200.  
  201.         FailOSErr(SetVol(NIL, vRefNum));
  202.  
  203.         rewrite(outFile, fileName);
  204.  
  205.         strH := GetString(LibraryReportID);
  206.         writeln(outfile, line1, ' ', strH^^);
  207.         writeln(line1, ' ', strH^^);
  208.         DisposHandle(handle(strH));
  209.  
  210.         strH := GetString(lastUploadedID);
  211.         writeln(outfile, line2, ' ', strH^^);
  212.         writeln(line2, ' ', strH^^);
  213.         DisposHandle(handle(strH));
  214.  
  215.         writeln(outfile);
  216.  
  217.         writeln(outfile, title1);
  218.         writeln(title1);
  219.         writeln(outfile, title2);
  220.         writeln(title2);
  221.  
  222.         FailOSErr(SetVol(NIL, currentVRefNum));
  223.  
  224.         strH := GetString(acctStrID);
  225.         acctStr := strH^^;
  226.         DisposHandle(handle(strH));
  227.  
  228.         strH := GetString(typeStrID);
  229.         typeStr := strH^^;
  230.         DisposHandle(handle(strH));
  231.  
  232.         strH := GetString(uploadedByID);
  233.         uploadedByStr := copy(concat(strH^^, '                    '), 1, 19);
  234.         DisposHandle(handle(strH));
  235.  
  236.         strH := GetString(dateStrID);
  237.         dateStr := strH^^;
  238.         DisposHandle(handle(strH));
  239.  
  240.     END;
  241.  
  242. {=================================================================}
  243.  
  244.     FUNCTION GetVolumeToCatalog : integer;
  245.         VAR
  246.             topLeft : Point;
  247.             emptyList : SFTypeList;
  248.             reply : SFReply;
  249.             currentVRefNum : integer;
  250.             volName : str255;
  251.             temp : integer;
  252.     BEGIN
  253.  
  254.         SetPt(topLeft, 40, 40);
  255.         SFGetFile(topLeft, 'Select volume to catalog', NIL, 0, emptyList, NIL, reply);
  256.  
  257.         IF reply.good THEN
  258.             BEGIN
  259.  
  260.                 GetVolumeToCatalog := reply.vRefNum;
  261.  
  262.             END
  263.  
  264.         ELSE
  265.  
  266.             GetVolumeToCatalog := -maxint;
  267.  
  268.     END;
  269.  
  270. {=================================================================}
  271.  
  272.     PROCEDURE CreateOutputFile;
  273.         VAR
  274.             topLeft : Point;
  275.             emptyList : SFTypeList;
  276.             reply : SFReply;
  277.     BEGIN
  278.  
  279.         SetPt(topLeft, 40, 40);
  280.         SFPutFile(topLeft, 'Select file for output', 'Section.Dir', NIL, reply);
  281.  
  282.         IF reply.good THEN
  283.             BEGIN
  284.  
  285.                 OpenOutputFile(reply.fName, reply.vRefNum);
  286.  
  287.             END
  288.  
  289.     END;
  290.  
  291. {=================================================================}
  292.  
  293.  
  294.     VAR
  295.         volToCatalog : integer;
  296. BEGIN
  297.  
  298.     ShowText;
  299.  
  300.     REPEAT
  301.  
  302.         volToCatalog := GetVolumeToCatalog;
  303.  
  304.         IF volToCatalog <> -maxint THEN
  305.             BEGIN
  306.  
  307.                 CreateOutputFile;
  308.  
  309.                 currentID := 1;
  310.  
  311.                 WriteSubdirectoryToSectionDirFile(volToCatalog, FALSE);
  312.                 WriteSubdirectoryToSectionDirFile(volToCatalog, TRUE);
  313.  
  314.                 close(outFile);
  315.  
  316.             END;
  317.  
  318.     UNTIL volToCatalog = -maxint;
  319.  
  320. END.